home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / Mops 2.7 / Mops source / System source / Undo < prev   
Text File  |  1994-11-02  |  3KB  |  124 lines
  1. \ UNDO    - mrh    Aug 94
  2.  
  3. (*
  4. This file is a first try at implementing a generic UNDO facility.  The
  5. concept is actually quite simple, but it should allow just about any kind
  6. of UNDO you might want.
  7. There is a handleList UNDO_LIST.  Each object in this list undoes some
  8. action.  Here's the way you set things up:
  9.  
  10. 1. Subclass UNDOABLE_ACTION for each kind of action you want to be
  11. undoable.  See the example at the end for how we do this for window
  12. resizing (not all that useful, but who cares, it's an example).
  13.  
  14. 2. Each such subclass should have an INIT: method that saves whatever
  15. info it needs to do an undo of that action.  The object on which the
  16. action to be performed will be pointed to by the ptr MyObject.
  17. This method must start by calling init: super, which will set up MyObject.
  18.  
  19. 3. The subclass should also have an UNDO: method that uses the saved info
  20. to undo the action.  Again the target object will pointed to by MyObject,
  21. so you should send late-bound messages to whatever MyObject points to.
  22.  
  23. 4. Your class whose objects are to have undoable actions on them, needs
  24. the appropriate methods to begin with
  25. ['] <undoable-action-class> make_undoable
  26.  
  27. That's it.
  28.  
  29. See the example for how to do it.
  30.  
  31. A fuller implementation of this idea would have some way to update undo_list
  32. if an object with outstanding undoable actions is deleted.
  33.  
  34. *)
  35.  
  36.  
  37. need window+        \ just for the example, actually
  38.  
  39.  
  40. :class UNDOABLE_ACTION  super{ object }
  41.  
  42.     ptr        myObject
  43.  
  44. :m SET_OBJECT:    ( ^obj -- )        put: myObject  ;m
  45.  
  46. :m INIT:      put: myObject  ;m
  47.  
  48. :m UNDO:    ;m        \ should be overridden!
  49.  
  50. ;class
  51.  
  52.  
  53. \ UNDO_LIST_CLASS is a one-off class for implementing UNDO_LIST.  Of course,
  54. \ I guess you might want multiple undo lists.  Be my guest.
  55.  
  56. :class  UNDO_LIST_CLASS  super{ handleList }
  57.  
  58.     var        MAX_UNDOS
  59.  
  60. :m SETMAX:    put: max_undos  ;m
  61.  
  62. :m NEWOBJ:        \ Overriding NewObj: on handleList.  If we're at the
  63.                 \  max limit, we delete the first item.
  64.                 
  65.     size: self  get: max_undos >=
  66.     IF    0 select: self  remove: self
  67.     THEN
  68.     newObj: super  ;m
  69.  
  70. :m CLASSINIT:    100  put: max_undos  ;m
  71.  
  72. ;class
  73.  
  74.  
  75. undo_list_class    UNDO_LIST
  76.  
  77.  
  78. : UNDO  { \ index -- }
  79.     size: undo_list  0EXIT
  80.     selectLast: undo_list
  81.     current: undo_list  -> index
  82.     obj: undo_list  undo: []
  83.     index select: undo_list            \ Sending undo: probably added a
  84.                                     \  new element to the end
  85.     remove: undo_list  ;            \ Finished with this one, so delete it
  86.  
  87.  
  88. : MAKE_UNDOABLE        \ ( ^undoable_action_subclass -- )
  89.     newObj: undo_list
  90.     ^base  obj: undo_list  init: []  unlock: undo_list  ;
  91.  
  92.  
  93. \ endload
  94.  
  95.  
  96. :class  uWindSize  super{ undoable_action }
  97.  
  98.     rect    oldRect
  99.     
  100. :m INIT:  ( ^wind-obj -- )
  101.     init: super
  102.     get: myObject  getRect: []  put: oldRect  ;m
  103.  
  104. :m UNDO:
  105.     getBot: oldRect  get: myObject  size: []  ;m
  106.  
  107. ;class
  108.  
  109.  
  110. :class  uWindow  super{ window+ }
  111.  
  112. :m SIZE:  ( x y -- )
  113.     ['] uWindSize  make_undoable
  114.     size: super  ;m
  115.  
  116. ;class
  117.  
  118.  
  119. uWindow WW
  120. view    VV
  121.  
  122. : GO    4 setmax: undo_list
  123.         vv test: ww  ;
  124.